home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / wwiv.arc / PART3.PAS < prev    next >
Pascal/Delphi Source File  |  1986-04-21  |  26KB  |  767 lines
  1. overlay procedure oldusers;
  2. type n=record
  3.          name:string[25];
  4.          number:integer;
  5.          laston:string[10];
  6.          lastonn:integer;
  7.        end;
  8.  
  9. var c1,c2,c3:integer; u:userrec;
  10.     x:array[1..maxusers] of n;
  11.     x1,x2:n;
  12.     abort,next:boolean;
  13.     i:str;
  14. begin
  15.   prompt('Sorting ');
  16.   reset(uf); c1:=0;
  17.   for c2:=1 to filesize(uf)-1 do begin
  18.     seek(uf,c2); read(uf,u);
  19.     if not u.deleted then begin
  20.       c1:=c1+1;
  21.       with x[c1] do begin
  22.         name:=u.name;
  23.         number:=c2;
  24.         laston:=u.laston;
  25.         lastonn:=daynum(u.laston);
  26.       end;
  27.     end;
  28.   end;
  29.   print(cstr(c1)+' users...'); nl; nl;
  30.   for c2:=1 to c1-1 do
  31.     for c3:=c2+1 to c1 do
  32.       if (x[c2].lastonn>x[c3].lastonn) or
  33.         ((x[c2].lastonn=x[c3].lastonn) and (x[c2].name>x[c3].name)) then begin
  34.         x1:=x[c2];
  35.         x[c2]:=x[c3];
  36.         x[c3]:=x1;
  37.       end;
  38.   abort:=false; c2:=1; c3:=daynum(date);
  39.   while (c2<=c1) and (not abort) do begin
  40.     i:=cstr(c3-x[c2].lastonn); while length(i)<4 do i:=' '+i;
  41.     i:=mln(mln(x[c2].name+' #'+cstr(x[c2].number),34)+x[c2].laston,45)+i;
  42.     printacr(i,abort,next);
  43.     c2:=c2+1;
  44.   end;
  45. end;
  46.  
  47. overlay procedure pstat;
  48. var c:char;
  49. begin
  50.   outkey(chr(12));
  51.   with systat do begin
  52.     print('New User Pass   : '+boardpw);
  53.     prompt('Board is        : '); if closedsystem then print('Closed') else print('Open');
  54.     print('Number Users    : '+cstr(users));
  55.     print('Number calls    : '+cstr(callernum));
  56.     print('Date            : '+lastdate);
  57.     print('Active today    : '+cstr(activetoday));
  58.     print('Calls today     : '+cstr(callstoday));
  59.     print('M posted today  : '+cstr(msgposttoday));
  60.     print('E sent today    : '+cstr(emailtoday));
  61.     print('F sent today    : '+cstr(fbacktoday));
  62.     print('U today         : '+cstr(uptoday));
  63.     prompt('Sysop           : '); if sysop then print('Available')
  64.       else print('NOT Available');
  65.     print('F waiting       : '+cstr(fw));
  66.     print('Disk free space : '+cstr(freek)+'k');
  67.   end;
  68.   if not useron then begin
  69.     nl;nl;print('Hit any key');
  70.     getkey(c);
  71.   end;
  72. end;
  73.  
  74.  
  75. overlay procedure uedit(usern:integer);
  76. var user,user1:userrec; c:char; r:restrictions; i,i1,x:integer; save:boolean; ii,is:str; f:file;
  77.   mr:mailrec; searchopt:record sl,dsl,comp:byte; end;
  78.  
  79.   overlay procedure stopt;
  80.   var n:integer; c:char;
  81.   begin
  82.     nl; nl;
  83.     prompt('SL restriction  : '); ini(searchopt.sl);
  84.     prompt('DSL restriction : '); ini(searchopt.dsl);
  85.     nl; for n:=1 to 8 do print(cstr(n)+'. '+comptyp[n]);
  86.     nl; prompt('Comp type (1-8, <CR>=none) ? '); onek(c,#13'12345678');
  87.     if c in ['1'..'8'] then searchopt.comp:=value(c) else searchopt.comp:=0;
  88.   end;
  89.  
  90.   overlay procedure delusr;
  91.   begin
  92.     prompt('Delete? '); if yn and (not user.deleted) then begin
  93.       save:=true; user.deleted:=true; dsr(user.name);
  94.       i:=usernum; usernum:=usern; rsm; usernum:=i;
  95.       user.waiting:=0; reset(mailfile);
  96.       for i:=0 to filesize(mailfile)-1 do begin
  97.         seek(mailfile,i); read(mailfile,mr); i1:=0;
  98.         if (mr.destin=usern) or (abs(mr.from)=usern) then begin
  99.           if abs(mr.from)=usern then i1:=mr.destin;
  100.           assign(f,filename(mr.msg)); {$I-} erase(f); {$I+} x:=ioresult;
  101.           mr.destin:=-1; mr.from:=0; seek(mailfile,i); write(mailfile,mr);
  102.         end;
  103.         if (i1>0) and (i1<filesize(uf)) then begin
  104.           seek(uf,i1); read(uf,user1); user1.waiting:=user1.waiting-1;
  105.           seek(uf,i1); write(uf,user1); if i1=1 then fw:=fw-1;
  106.         end;
  107.       end;
  108.     end;
  109.   end;
  110.  
  111.   overlay procedure renusr;
  112.   begin
  113.     if user.deleted then print('Can''t rename deleted users.') else begin
  114.       nl;prompt('Enter new name or <CR>: '); input(ii,25);
  115.       if ii<>'' then begin
  116.         dsr(user.name); isr(ii,usern); user.name:=ii; save:=true;
  117.         if usern=usernum then thisuser.name:=ii;
  118.       end;
  119.     end;
  120.   end;
  121.  
  122.   overlay procedure printhelp;
  123.   begin
  124.     print('S - change seclev    A - change access');
  125.     print('[ - down one user    ] - up one user');
  126.     print('U - go to user       B - board access');
  127.     print('D - delete user      R - restore user');
  128.     print('N - change name      P - change phone number');
  129.     print('E - change real name Q - quit');
  130.     print('L - aLert for user   T - Transfer SL');
  131.     print('{ - search down      } - search up');
  132.     print('O - set search Options');
  133.     prompt('(-*-)'); getkey(c); skey(c);
  134.   end;
  135.  
  136.   overlay procedure search(i:integer);
  137.   var n:integer; u:userrec;
  138.     function okusr(n:integer):boolean;
  139.     begin
  140.       seek(uf,n); read(uf,u);
  141.       if (u.sl>=searchopt.sl) and (u.dsl>=searchopt.dsl) and
  142.         ((u.comptype=searchopt.comp) or (searchopt.comp=0)) then
  143.           okusr:=true
  144.       else
  145.         okusr:=false;
  146.     end;
  147.  
  148.   begin
  149.     n:=usern;
  150.     repeat
  151.       usern:=usern+i;
  152.       if usern=0 then usern:=filesize(uf)-1;
  153.       if usern=filesize(uf) then usern:=1;
  154.     until okusr(usern) or (usern=n);
  155.   end;
  156.  
  157. begin
  158.   reset(uf); with searchopt do begin sl:=0; dsl:=0; comp:=0; end;
  159.   repeat
  160.    seek(uf,usern); read(uf,user); save:=false;
  161.    if (usern=usernum) and useron then user:=thisuser;
  162.    with user do begin
  163.     cls;
  164.     prompt('Name         : '+name+' #'+cstr(usern));
  165.     if deleted then print('  XXXXXXXXXXXXXXX') else nl;
  166.     print('Real name    : '+realname);
  167.     print('Phone number : '+ph);
  168.     writeln('Password     : '+pw);
  169.     print('Last on      : '+laston);
  170.     print('Messages     : P='+cstr(msgpost)+' E='+cstr(emailsent)+' F='+
  171.       cstr(feedback)+' W='+cstr(waiting));
  172.     prompt('Logged on    : '+cstr(loggedon)); if laston=date then
  173.       prompt('  '+cstr(ontoday)) else prompt('  0');
  174.     print('  I'+cstr(illegal));
  175.     print('Sec Lev      : '+cstr(sl));
  176.     if sl=99 then print('SBN          : '+cstr(sbn));
  177.     print('Computer type: '+comptyp[comptype]);
  178.     print('DL Sec Lev   : '+cstr(dsl)+' - '+cstr(uploads)+'-'+cstr(uk)+
  179.       ' / '+cstr(downloads)+'-'+cstr(dk));
  180.     prompt('Restrictions : ');
  181.     for r:=rlogon to rmsg do
  182.       if r in ac then prompt(copy('LCVBA*PEKM',ORD(R)+1,1)) else prompt(' '); nl;
  183.     prompt('Board access : ');
  184.     for c:='A' to 'G' do
  185.       if c in ar then outkey(c) else outkey(' '); nl; nl;
  186.     if nomail in option then print('Mailbox closed.');
  187.     if alert in option then print('Alert set.');
  188.    end;
  189.    prompt('Option :'); onek(c,'QSA[]UBDRNPELTO{}?'); c:=upcase(c);
  190.    case c of
  191.       'B': begin
  192.              prompt('Which board? '); onek(c,'ABCDEFG'); c:=upcase(c);
  193.              if c in ['A'..'G'] then if c in user.ar then user.ar:=user.ar-[c]
  194.                else user.ar:=user.ar+[c];
  195.              if c in ['A'..'G'] then save:=true;
  196.            end;
  197.       'O': stopt;
  198.       '}': search(1);
  199.       '{': search(-1);
  200.       'U': begin
  201.              close(uf); prompt('Enter user: ');
  202.              finduser(i); if i>0 then usern:=i; reset(uf);
  203.            end;
  204.       '[': begin
  205.              usern:=usern-1; if usern=0 then usern:=filesize(uf)-1;
  206.            end;
  207.       ']': begin
  208.              usern:=usern+1; if usern=filesize(uf) then usern:=1;
  209.            end;
  210.       'A': begin save:=true;
  211.               print('LCVBA*PEKM');
  212.               nl;prompt('Which? ');; onek(c,'LCVBA*PEKM'+#13); c:=upcase(c); print(c); nl;
  213.               if c<>#13 then acch(c,user); save:=true;
  214.            end;
  215.       'S': begin prompt('Enter new SL: '); input(ii,4);
  216.                  if ii<>'' then begin
  217.                    i:=value(ii); save:=true; if i<>255 then user.sl:=i;
  218.                    if user.sl=99 then begin
  219.                      prompt('Which board #? '); input(ii,2);
  220.                      user.sbn:=value(ii); save:=true;
  221.                    end;
  222.                  end;
  223.            end;
  224.       'T': begin prompt('Enter new DSL: '); input(ii,4);
  225.                  if ii<>'' then user.dsl:=value(ii); save:=true;
  226.            end;
  227.       'D': delusr;
  228.       'R': if user.deleted then begin save:=true; isr(user.name,usern); user.deleted:=false; end;
  229.       'N': renusr;
  230.       'P': begin prompt('New phone number: '); input(ii,12); if ii<>'' then
  231.              begin user.ph:=ii; save:=true; end;
  232.            end;
  233.       'E': begin prompt('New Real Name: '); inputl(ii,14); if ii<>'' then
  234.              begin user.realname:=ii; save:=true; end;
  235.            end;
  236.       'L': begin
  237.              if alert in user.option then
  238.                user.option:=user.option-[alert] else
  239.                user.option:=user.option+[alert];
  240.              save:=true;
  241.            end;
  242.       '?': printhelp;
  243.    end;
  244.    if save then begin seek(uf,usern); write(uf,user); if usern=usernum then thisuser:=user; end;
  245.   until (c='Q') or hangup;
  246.   close(uf);
  247. end;
  248.  
  249. overlay procedure initvotes;
  250. var vdata:file of vdatar; cv,tv,ii:integer; i,i1,i2:str; vd:vdatar; t1,tf:boolean;
  251.     u1:userrec;
  252. begin
  253.   begin
  254.     assign(vdata,'gfiles\voting.dat'); {$I-} reset(vdata); {$I+}
  255.     if ioresult<>0 then begin
  256.       rewrite(vdata); vd.question:='<< NO QUESTION >>'; vd.numa:=0;
  257.       for cv:=0 to 8 do write(vdata,vd);
  258.     end;
  259.     repeat
  260.       cls;
  261.       for cv:=1 to 9 do begin
  262.         seek(vdata,cv-1); read(vdata,vd);
  263.         print(cstr(cv)+': '+vd.question);
  264.       end;
  265.       prompt('Which? '); input(i,2);
  266.       ii:=value(i); t1:=false;
  267.       if (ii>0) and (ii<10) then begin
  268.         cv:=1; t1:=true;
  269.         print('Enter new question:'); prompt(':');
  270.         inputl(vd.question,79);
  271.         if vd.question='' then begin vd.numa:=0; vd.question:='<< NO QUESTION >>';
  272.         end else begin
  273.           vd.answ[0].ans:='No Comment';
  274.           vd.answ[0].numres:=0;
  275.           nl; print('Enter blank line for last answer,');
  276.           print('max 9 answers, 25 chars/answer');
  277.           tf:=false;
  278.           repeat
  279.             prompt(cstr(cv)+':'); inputl(vd.answ[cv].ans,25); vd.answ[cv].numres:=0;
  280.             if vd.answ[cv].ans='' then begin
  281.               tf:=true;
  282.               if cv=1 then vd.question:='<< NO QUESTION >>'
  283.             end else cv:=cv+1;
  284.           until hangup or (cv=10) or tf;
  285.           vd.numa:=cv-1;
  286.         end;
  287.         seek(vdata,ii-1); write(vdata,vd);
  288.         vqu[ii]:= vd.numa<>0;
  289.         reset(uf); for cv:=1 to filesize(uf)-1 do begin
  290.           seek(uf,cv); read(uf,u1); u1.vote[ii]:=0; seek(uf,cv); write(uf,u1);
  291.         end;
  292.         close(uf);
  293.         thisuser.vote[ii]:=0;
  294.       end;
  295.     until not t1;
  296.     close(vdata);
  297.   end;
  298. end;
  299.  
  300. overlay procedure boardedit;
  301. var i1,i2,ii:integer; c:char; ij:str;
  302. begin
  303.  prompt('PW? '); echo:=false; input(ij,8); echo:=true;
  304.  if ij=systat.sysoppw then
  305.  repeat
  306.   cls;
  307.   print('NN K Name                      Filename     SL  MaxM Password   AR An');
  308.   print('-- = ------------------------- ============ --- ==== ---------- == --');
  309.   for ii:=1 to numboards do with boards[ii] do begin
  310.     prompt(mn(ii,2)+' '+key+' '+mln(name,25)+' '+mln(filename,12)+' '+mn(sl,3)+' ');
  311.     prompt(mn(maxmsgs,3)+'  '+mln(pw,10)+' '); if ar='@' then prompt('   ') else prompt(ar+'  ');
  312.     case anonymous of
  313.       yes:print('Y');
  314.       no:print('N');
  315.       forced:print('F');
  316.       dearabby:print('DA');
  317.     end;
  318.   end;
  319.   nl; prompt('D)elete, I)nsert, M)odify, Q)uit  :'); onek(c,'QDIM');
  320.   case c of
  321.     'D': begin
  322.            prompt('Board number to delete? '); inu(ii);
  323.            if (ii>0) and (ii<=numboards) then begin
  324.              prompt(boards[ii].name+'   Delete it? ');
  325.              if yn then begin
  326.                numboards:=numboards-1; for i1:=ii to numboards do
  327.                  boards[i1]:=boards[i1+1];
  328.                rewrite(bf); for i1:=1 to numboards do write(bf,boards[i1]);
  329.                close(bf); reset(uf); for i1:=1 to filesize(uf)-1 do begin
  330.                  seek(uf,i1);read(uf,user); for i2:=ii to numboards do begin
  331.                    user.qscn[i2]:=user.qscn[i2+1]; user.qscan[i2]:=user.qscan[i2+1];
  332.                  end;
  333.                  seek(uf,i1); write(uf,user);
  334.                end; close(uf);
  335.              end;
  336.            end;
  337.          end;
  338.     'M': begin
  339.            prompt('Board number to edit? '); inu(ii);
  340.            if (ii>0) and (ii<=numboards) then begin with boards[ii] do
  341.            repeat
  342.              cls;
  343.              print('   Board      : '+cstr(ii));
  344.              print('1. Name       : '+name);
  345.              print('2. Filename   : '+filename);
  346.              print('3. Key        : '+key);
  347.              print('4. SL         : '+cstr(sl));
  348.              print('5. AR         : '+ar);
  349.              print('6. Password   : "'+pw+'"');
  350.              print('7. Max Mess   : '+cstr(maxmsgs));
  351.              prompt('8. Anonymous  : '); case anonymous of
  352.                yes:print('Yes');
  353.                no:print('No');
  354.                forced:print('Force');
  355.                dearabby:print('Dear abby');
  356.              end;
  357.              nl; prompt('Which? '); onek(c,'12345678Q');
  358.              case c of
  359.                '1':begin prompt('New name? '); inputl(name,25); end;
  360.                '2':begin prompt('New filename? '); input(filename,12); end;
  361.                '3':begin prompt('New key? '); getkey(c); key:=c; nl;
  362.                          if not (key in ['"','#','%','&','(',')','+',',','-',
  363.                             '.',':',';','<','=','>']) then key:=' '; end;
  364.                '4':begin prompt('New SL? '); ini(sl); end;
  365.                '5':begin prompt('New AR? '); getkey(c); ar:=upcase(c);
  366.                      if (ar<'A') or (ar>'G') then ar:='@'; nl; end;
  367.                '6':begin prompt('New PW? '); input(pw,10); end;
  368.                '7':begin prompt('Max messages? '); ini(maxmsgs); end;
  369.                '8':begin prompt('New ANST (Y,N,F,D) ? '); onek(c,'YNFD');
  370.                      case c of
  371.                        'Y':anonymous:=yes;
  372.                        'N':anonymous:=no;
  373.                        'F':anonymous:=forced;
  374.                        'D':anonymous:=dearabby;
  375.                      end;
  376.                    end;
  377.              end;
  378.            until (c='Q') or hangup;
  379.            reset(bf); seek(bf,ii-1); write(bf,boards[ii]); close(bf); c:=' ';
  380.           end;
  381.          end;
  382.     'I': begin
  383.            prompt('Board number to insert before? '); inu(ii);
  384.            if (ii>0) and (ii<=numboards+1) and (numboards<19) then begin
  385.              numboards:=numboards+1; for i1:=numboards downto ii do
  386.                boards[i1]:=boards[i1-1];
  387.              with boards[ii] do begin
  388.                name:='NEW BOARD';
  389.                filename:='newboard';
  390.                sl:=30;
  391.                maxmsgs:=50;
  392.                pw:='';
  393.                anonymous:=no;
  394.                ar:='@';
  395.                key:=' ';
  396.              end;
  397.              rewrite(bf); for i1:=1 to numboards do write(bf,boards[i1]);
  398.              close(bf); reset(uf); for i1:=1 to filesize(uf)-1 do begin
  399.                seek(uf,i1);read(uf,user); for i2:=numboards downto ii do begin
  400.                  user.qscn[i2]:=user.qscn[i2-1]; user.qscan[i2]:=user.qscan[i2-1];
  401.                end;
  402.                user.qscan[ii].number:=-32767; user.qscan[ii].ltr:='A'; user.qscn[ii]:=true;
  403.                seek(uf,i1); write(uf,user);
  404.              end; close(uf);
  405.            end;
  406.          end;
  407.   end;
  408.  until (c='Q') or hangup;
  409. end;
  410.  
  411. overlay procedure mailr;
  412. var ii:integer; mr:mailrec; abort,a:boolean; c:char; u:userrec; is:str;
  413. begin
  414.   {$I-} reset(mailfile); {$I+} c:=' ';
  415.   if ioresult=0 then begin
  416.     reset(uf);
  417.     ii:=filesize(mailfile)-1; c:=' ';
  418.     while (ii>=0) and (c<>'Q') do begin
  419.       seek(mailfile,ii); read(mailfile,mr);
  420.       if mr.destin<>-1 then begin
  421.         repeat
  422.           seek(uf,mr.destin); read(uf,u);
  423.           print('To '+u.name+' #'+cstr(mr.destin)); a:=true;
  424.           print('Title: '+mr.title);
  425.           readmsg(mr.msg,a,next);
  426.           prompt('R,D,Q,<space>  : ');
  427.           if next then c:=' ' else getkey(c); skey(c); c:=upcase(c); print(c);
  428.           if c='D' then begin
  429.             close(uf); is:=rmail(ii); reset(uf);
  430.             if usernum=mr.destin then thisuser.waiting:=thisuser.waiting-1;
  431.           end;
  432.           nl;nl;
  433.         until (c<>'R');
  434.       end;
  435.       ii:=ii-1;
  436.     end;
  437.     close(mailfile);
  438.     close(uf);
  439.   end;
  440. end;
  441.  
  442. overlay procedure changestuff;
  443. var i,i1:str; c:char; b1,b2:boolean;
  444.  
  445.   procedure po;
  446.   begin
  447.     clrscr;
  448.     writeln('A. Sysop Password    : "'+systat.sysoppw+'"');
  449.     writeln('B. New User Password : "'+systat.boardpw+'"');
  450.     write('C. System            : ');
  451.       if systat.closedsystem then writeln('Closed') else writeln('Open');
  452.     writeln; writeln; writeln; writeln;
  453.   end;
  454.  
  455. begin
  456.   write('PW? '); input(i,8);
  457.   if i=systat.sysoppw then begin cls;
  458.     po;
  459.     repeat
  460.       b1:=false;
  461.       repeat
  462.         gotoxy(1,8);
  463.         write('Which (A-C,Q=Quit) ? ');
  464.         clreol;
  465.         read(kbd,c);
  466.         c:=upcase(c);
  467.       until c in ['A'..'C','Q'];
  468.       case c of
  469.         'Q':b1:=true;
  470.         'B':begin
  471.               writeln;
  472.               write('New NewUser Password : ');
  473.               input(i,8);
  474.               writeln;
  475.               writeln('NewUser Password: "'+i+'"');
  476.               writeln;
  477.               write('Is this what you want? ');
  478.               if yn then systat.boardpw:=i;
  479.               po;
  480.             end;
  481.         'A':begin
  482.               writeln;
  483.               write('New Sysop Password : ');
  484.               input(i,8);
  485.               writeln;
  486.               writeln('Sysop Password: "'+i+'"');
  487.               writeln;
  488.               write('Is this what you want? ');
  489.               if yn then systat.sysoppw:=i;
  490.               po;
  491.             end;
  492.         'C':begin
  493.               writeln;
  494.               write('Do you want the system closed? ');
  495.               b2:=yn;
  496.               writeln;
  497.               write('System: '); if b2 then writeln('Closed') else writeln('Open');
  498.               writeln;
  499.               write('Is this what you want? ');
  500.               if yn then systat.closedsystem:=b2;
  501.               po;
  502.             end;
  503.       end;
  504.     until b1;
  505.     reset(systatf);
  506.     write(systatf,systat);
  507.     close(systatf);
  508.   end;
  509. end;
  510.  
  511. overlay procedure dlboardedit;
  512. var ulf:file of ulrec;
  513.     uboards:array[0..19] of ulrec;
  514.     i1,ii,culb,maxulb:integer;
  515.     c:char; done:boolean;
  516.     ij:str;
  517. begin
  518.  assign(ulf,'gfiles\uploads.dat');
  519.  reset(ulf); maxulb:=-1;
  520.  while not eof(ulf) do begin maxulb:=maxulb+1; read(ulf,uboards[maxulb]); end;
  521.  close(ulf);
  522.  prompt('PW? '); echo:=false; input(ij,8); echo:=true;
  523.  if ij=systat.sysoppw then
  524.  repeat
  525.   cls; done:=false;
  526.   print('NN Board Name                Filename     DSL MaxF  Password');
  527.   print('-- ========================= ------------ === ----  ========');
  528.   for ii:=0 to maxulb do with uboards[ii] do
  529.     print(mn(ii,2)+' '+mln(name,25)+' '+mln(filename,12)+' '+mn(dsl,3)+' '+mn(maxfiles,3)+'   '+mln(password,10));
  530.   nl; prompt('D)elete, I)nsert, M)odify, Q)uit  :'); onek(c,'QDIM');
  531.   case c of
  532.     'Q':done:=true;
  533.     'D':begin
  534.            prompt('Directory number to delete? '); inu(ii);
  535.            if (ii>0) and (ii<=maxulb) then begin
  536.              prompt(uboards[ii].name+'   Delete it? ');
  537.              if yn then begin
  538.                maxulb:=maxulb-1; for i1:=ii to maxulb do
  539.                  uboards[i1]:=uboards[i1+1];
  540.                rewrite(ulf); for i1:=0 to maxulb do write(ulf,uboards[i1]);
  541.                close(ulf);
  542.              end;
  543.            end;
  544.         end;
  545.    'M': begin
  546.            prompt('Directory number to edit? '); inu(ii); cls;
  547.            if (ii>=0) and (ii<=maxulb) then with uboards[ii] do begin
  548.            repeat
  549.              cls; print('   Directory  : '+cstr(ii));
  550.              print('1. Name       : '+name);
  551.              print('2. Filename   : '+filename);
  552.              print('3. DSL        : '+cstr(dsl));
  553.              print('4. Password   : "'+password+'"');
  554.              print('5. Max files  : '+cstr(maxfiles));
  555.              nl; prompt('Which? '); onek(c,'Q12345');
  556.              case c of
  557.                '1':begin prompt('New name? '); inputl(name,25); end;
  558.                '2':begin prompt('New filename? '); input(filename,12); end;
  559.                '3':begin prompt('New DSL? '); ini(dsl); end;
  560.                '4':begin prompt('New PW? '); input(password,10); end;
  561.                '5':begin prompt('Max files? '); inu(maxfiles); end;
  562.              end;
  563.            until (c='Q') or hangup;
  564.            reset(ulf); seek(ulf,ii); write(ulf,uboards[ii]); close(ulf); c:=' ';
  565.          end;
  566.         end;
  567.     'I': begin
  568.            prompt('Board number to insert before? '); inu(ii);
  569.            if (ii>0) and (ii<=maxulb+1) and (maxulb<19) then begin
  570.              maxulb:=maxulb+1; for i1:=maxulb downto ii do
  571.                uboards[i1]:=uboards[i1-1];
  572.              with uboards[ii] do begin
  573.                name:='NEW DIRECTORY';
  574.                filename:='newdir';
  575.                dsl:=0;
  576.                maxfiles:=50;
  577.                password:='';
  578.              end;
  579.              rewrite(ulf); for i1:=0 to maxulb do write(ulf,uboards[i1]);
  580.              close(ulf);
  581.            end;
  582.          end;
  583.   end;
  584.  until done or hangup;
  585. end;
  586.  
  587. overlay procedure init;
  588. var a,b,c:integer;
  589.     vdf:file of vdatar;
  590.     vd:vdatar;
  591.     fi:text;
  592.     i:str;
  593.     fil:file of pnr;
  594.     ns:pnr;
  595.     f:file;
  596.     ch1:char;
  597. begin
  598.  textcolor(white);
  599.  if daynum(date)=0 then begin
  600.    clrscr;
  601.    writeln('You need to set the date & time first.');
  602.    halt;
  603.  end;
  604.  comport:=comnum;
  605.  maxspd:=maxbaud;
  606.  iport; ldate:=daynum(date);
  607.   ch:=false; lil:=0; thisuser.pagelen:=20; buf:=''; chatcall:=false;
  608.   spd:=''; lastname:=''; ll:=''; cursor:=''; i:=''; chatr:='';
  609.   assign(bf,'gfiles\boards.dat');
  610.   assign(uf,'gfiles\user.lst');
  611.   assign(sf,'gfiles\names.lst');
  612.   assign(sysopf,'gfiles\sysop.log');
  613.   assign(mailfile,'gfiles\email.dat');
  614.   assign(systatf,'gfiles\status');
  615.   reset(systatf); read(systatf,systat);close(systatf);
  616.   assign(smf,'gfiles\shortmsg.dat');
  617.   assign(cf,'gfiles\chat.msg'); cfo:=false;
  618.   reset(sf); for a:=0 to systat.users do read(sf,srl[a]); close(sf);
  619.   for a:=systat.users+1 to maxusers do begin srl[a].name:=''; srl[a].number:=0; end;
  620.   hangup:=false;
  621.   incom:=false; outcom:=false;
  622.   echo:=true; doneday:=false;
  623.   reset(bf);
  624.   numboards:=filesize(bf);
  625.   for t:=1 to numboards do
  626.     read(bf,boards[t]);
  627.   close(bf);
  628.   assign(slf,'gfiles\seclev.dat'); reset(slf); for c:=0 to 255 do read(slf,seclev[c]);
  629.   close(slf);
  630.   reset(uf);
  631.   if filesize(uf)>1 then begin seek(uf,1); read(uf,user); fw:=user.waiting;
  632.   end else fw:=0;
  633.   close(uf);
  634.   assign(f,'gfiles\help.msg');
  635.   for ch1:='0' to '^' do helpi[ch1]:=0;
  636.   {$I-} reset(f,1); {$I+}
  637.   if ioresult=0 then begin
  638.     blockread(f,help[1],25000,a);
  639.     close(f);
  640.     b:=1;
  641.     while (b<a) do begin
  642.       if help[b]='|' then begin
  643.         ch1:=help[b+1];
  644.         if ch1 in ['0'..'^'] then begin
  645.           c:=b;
  646.           while (help[c]<>#10) and (abs(c-b)<80) do c:=c+1;
  647.           c:=c+1;
  648.           if c<a then helpi[ch1]:=c;
  649.         end;
  650.       end;
  651.       b:=b+1;
  652.     end;
  653.     help[a+1]:='|';
  654.   end;
  655.   assign(vdf,'gfiles\voting.dat');
  656.   {$I-} reset(vdf); {$I+}
  657.   if ioresult=0 then begin
  658.     for a:=1 to 9 do begin
  659.       read(vdf,vd);
  660.       vqu[a]:=vd.numa<>0;
  661.     end;
  662.     close(vdf);
  663.   end else for a:=1 to 9 do vqu[a]:=false;
  664.   assign(fi,'gfiles\trashcan.txt'); {$I-} reset(fi); {$I+}
  665.   if ioresult<>0 then begin
  666.     rewrite(fi); i:='FUCK'; writeln(fi,i); i:='SID VICIOUS'; writeln(fi,i);
  667.     i:='SYSOP'; writeln(fi,i); i:='JEFF THE RIPPER'; writeln(fi,i);
  668.   end;
  669.   close(fi);
  670.   assign(fil,'gfiles\numbers.trm');
  671.   {$I-} reset(fil); {$I+}
  672.   if ioresult<>0 then begin
  673.     rewrite(fil);
  674.     ns.name:='========================================';
  675.     ns.number:='- --- --- ----';
  676.     ns.hs:=1;
  677.     for c:=1 to 9 do write(fil,ns);
  678.   end;
  679.   close(fil);
  680.   a:=freek;
  681. end;
  682.  
  683. overlay procedure movemsg(var pl,cn:integer);
  684. var mr,mr1:messagerec; i:str; c1,c2,c3,ob:integer; done:boolean;
  685.  
  686.   function gtr(mr,mr1:messages):boolean;
  687.   begin
  688.    if mr.ext>mr1.ext then gtr:=true else
  689.     if mr.ltr>mr1.ltr then gtr:=true else
  690.       if (mr.ltr=mr1.ltr) and (mr.number>mr1.number) then
  691.         gtr:=true
  692.       else gtr:=false;
  693.   end;
  694.  
  695. begin
  696.   nl; nl; if (cn>0) and (cn<=pl) then begin
  697.     print('Move message'); c1:=0; done:=false;
  698.     repeat
  699.       prompt('To which board (1-'+cstr(numboards)+') ?=list, Q=Quit :');
  700.       input(i,3);
  701.       if (i='') or (i='Q') then done:=true;
  702.       if i='?' then begin
  703.         nl;
  704.         for c2:=1 to numboards do
  705.           print(cstr(c2)+': '+boards[c2].name);
  706.         nl;
  707.       end;
  708.       c1:=value(i);
  709.       if (c1>0) and (c1<=numboards) then done:=true;
  710.     until done;
  711.     if (c1>0) and (c1<=numboards) then begin
  712.       seek(mf,cn); read(mf,mr); pl:=pl-1;
  713.       for c2:=cn+1 to pl+1 do begin
  714.         seek(mf,c2);read(mf,mr1); seek(mf,c2-1); write(mf,mr1);
  715.       end;
  716.       seek(mf,0); mr1.message.number:=pl; write(mf,mr1);
  717.       close(mf);
  718.       ob:=board;
  719.       board:=c1;
  720.       iscan(pl);
  721.       if pl>=boards[board].maxmsgs then deletem(pl,1);
  722.       c1:=pl;
  723.       if c1>0 then begin seek(mf,c1); read(mf,mr1); end;
  724.       while gtr(mr1.message,mr.message) and (c1>0) do begin
  725.         c1:=c1-1;
  726.         if c1>0 then begin seek(mf,c1); read(mf,mr1); end;
  727.       end;
  728.       c1:=c1+1;
  729.       pl:=pl+1;
  730.       for c2:=pl downto c1+1 do begin
  731.         seek(mf,c2-1); read(mf,mr1); seek(mf,c2); write(mf,mr1);
  732.       end;
  733.       seek(mf,c1); write(mf,mr);
  734.       mr.message.number:=pl; seek(mf,0); write(mf,mr);
  735.       close(mf);
  736.       board:=ob;
  737.       iscan(pl);
  738.       if cn>pl then cn:=pl;
  739.       print('Moved.');
  740.     end;
  741.   end;
  742. end;
  743.  
  744. overlay procedure hangupphone;
  745. var rl:real; try:integer;
  746.   procedure dely(r:real);
  747.   var r1:real;
  748.   begin
  749.     r1:=timer;
  750.     while abs(timer-r1)<r do;
  751.   end;
  752.  
  753. begin
  754.   try:=0;
  755.   term_ready(false);
  756.   while (try<2) and cdet do begin
  757.     dely(2.0);
  758.     pr1(#1#1#1);
  759.     rl:=timer;
  760.     while (cinkey<>'0') and (abs(timer-rl)<2.0) do;
  761.     dely(0.8);
  762.     pr('ATH');
  763.     try:=try+1;
  764.     dely(0.3);
  765.   end;
  766. end;
  767.